Private Static Sub DecryptBlock(Xl As Long, Xr As Long)
Dim i As Long, j As Long, K As Long
K = Xr
Xr = Xl Xor m_pBox(ROUNDS + 1)
Xl = K Xor m_pBox(ROUNDS)
j = ROUNDS - 2
For i = 0 To (ROUNDS \ 2 - 1)
Xl = Xl Xor f(Xr)
Xr = Xr Xor m_pBox(j + 1)
Xr = Xr Xor f(Xl)
Xl = Xl Xor m_pBox(j)
j = j - 2
Next
End Sub
Private Static Sub EncryptBlock(Xl As Long, Xr As Long)
Dim i As Long, j As Long, Temp As Long
j = 0
For i = 0 To (ROUNDS \ 2 - 1)
Xl = Xl Xor m_pBox(j)
Xr = Xr Xor f(Xl)
Xr = Xr Xor m_pBox(j + 1)
Xl = Xl Xor f(Xr)
j = j + 2
Next
Temp = Xr
Xr = Xl Xor m_pBox(ROUNDS)
Xl = Temp Xor m_pBox(ROUNDS + 1)
End Sub
Public Sub EncryptByte(byteArray() As Byte, Optional Key As String)
Dim Offset As Long, OrigLen As Long, LeftWord As Long, RightWord As Long, CipherLen As Long, CipherLeft As Long, CipherRight As Long, CurrPercent As Long, NextPercent As Long
If (Len(Key) > 0) Then Me.Key = Key
OrigLen = UBound(byteArray) + 1
CipherLen = OrigLen + 12
If (CipherLen Mod 8 <> 0) Then CipherLen = CipherLen + 8 - (CipherLen Mod 8)
If (CurrPercent <> 100) Then RaiseEvent Progress(100)
End Sub
Public Function EncryptString(Text As String, Optional Key As String, Optional OutputInHex As Boolean) As String
Dim byteArray() As Byte
byteArray() = StrConv(Text, vbFromUnicode)
Call EncryptByte(byteArray(), Key)
EncryptString = StrConv(byteArray(), vbUnicode)
If OutputInHex = True Then EncryptString = EnHex(EncryptString)
End Function
Public Function DecryptString(Text As String, Optional Key As String, Optional IsTextInHex As Boolean) As String
Dim byteArray() As Byte
If IsTextInHex = True Then Text = DeHex(Text)
byteArray() = StrConv(Text, vbFromUnicode)
Call DecryptByte(byteArray(), Key)
DecryptString = StrConv(byteArray(), vbUnicode)
End Function
Private Function EnHex(Data As String) As String
Dim iCount As Double, sTemp As String
Reset
For iCount = 1 To Len(Data)
sTemp = Hex$(Asc(Mid$(Data, iCount, 1)))
If Len(sTemp) < 2 Then sTemp = "0" & sTemp
Append sTemp
Next
EnHex = GData
Reset
End Function
Private Function DeHex(Data As String) As String
Dim iCount As Double
Reset
For iCount = 1 To Len(Data) Step 2
Append Chr$(Val("&H" & Mid$(Data, iCount, 2)))
Next
DeHex = GData
Reset
End Function
Public Sub DecryptByte(byteArray() As Byte, Optional Key As String)
On Error GoTo errorhandler
Dim Offset As Long, OrigLen As Long, LeftWord As Long, RightWord As Long, CipherLen As Long, CipherLeft As Long, CipherRight As Long, CurrPercent As Long, NextPercent As Long
